Shareware Grab Bag/Shareware Grab Bag.iso/002/envptibm.arc/SIDEPRNT.PAS

Pascal/Delphi Source File | 1987-05-19 | 6.0 KB | 241 lines

{
 SIDEPRNT ... sideways (rotated) printing ...
 Author --- John T. Bagwell, Jr.

 MODIFIED-- John R. DeBolt -- April 1987 to operate on an IBM
            compatible, OKIDATA ML192 printer.

Uses Character tables in the BIOS ROM sto do a simple form of
sideways printing. Character values above 127 aren't supported.

Formfeed acts as a 'page' eject, even in the middle of a line;
a line ends at CR/LF, FF, or end-of-file.
}

program SidePrint;

const
  PrintMultipleSpacing = #13#27#51#1#10;
  JiggleDown = #13#27#51#24;
  NormalSpacing = #27#65#12#27#50;
  GraphicsPrint = #27;
  ResetPrinter  = #24;
  LineFeed = #10;
  FormFeed = #12;
  AddX = 25;
                            { possible choices }
  BitsPerChar =      9;   {   9     9 }
  PrintType =      #75;   { #75   #75 }
  N1 =            #225;   {#221  #225 }
  N2 =              #0;   {  #1    #0 }
  MaxLineLen =    1000;   { 480   480 }
  MaxLinesPerPage = 25;   {  53    25 }

type
  BitMap = array[0..7] of Char;
  Line = array[1..MaxLineLen] of Char;

var
  zero1: byte;
  Paper: array[1..MaxLinesPerPage] of Line;
  zero2: byte;
  LineNo,CharNo,i,j,k,BitsPerPage,LineLen: Integer;
  Cindex,PrintMultiple: Byte;
  RetFile,InFile: Text;
  InChar: Char;
  CharTable: array[0..127] of BitMap absolute $F000:$FA6E;  {BIOS Table}

procedure ZERO;
  begin
    FillChar(zero1, ofs(zero2) - ofs(zero1) + sizeof(zero2), 0);
  end;

(*---------------------------------*)
(*         READ ONE PAGE           *)
(*---------------------------------*)

procedure ReadOnePage;

var
  LineSize: array[1..91] of Integer;    {big enough for all options}
  eject: Boolean;

begin
  LineNo:=1;
  CharNo:=0;
  LineLen:=0;
  eject:=False;
  Zero;

  For i:=1 to MaxLinesPerPage do     {erase old lines}
    LineSize[i]:=0;

repeat
        {accumulate a line ...}
  While (not eoln(RetFile)) AND (not eject) do
    begin
      Read(RetFile,InChar);
      If InChar = FormFeed then          {watch for page ejects}
        If (LineNo = 1) AND (CharNo = 0) then
            {Ignore redundant page ejects}
        else
          eject:=True
      else
        If CharNo <= MaxLineLen then       {build a line}
          begin
            CharNo:=CharNo+1;
            Paper[LineNo,CharNo]:=InChar;
          end;
    end;

          {at end of each line ...}

    If CharNo > LineLen then             {save longest line length}
      LineLen:=CharNo;
    LineSize[LineNo]:=CharNo;
    LineNo:=LineNo+1;
    CharNo:=0;
    If eoln(RetFile) then
      ReadLn(RetFile);                    {get the end-of-line mark}

      {force eject when page is full ...}

    If LineNo > MaxLinesPerPage then
      eject:=True;

until eof(RetFile) OR (eject);

  LineNo:=12;
  CharNo:=0;
  LineLen:=0;
  eject:=False;

repeat
        {accumulate a line ...}
  While (not eoln(InFile)) AND (not eject) do
    begin
      Read(InFile,InChar);
      If InChar = FormFeed then          {watch for page ejects}
        If (LineNo = 1) AND (CharNo = 0) then
            {Ignore redundant page ejects}
        else
          eject:=True
      else
        If CharNo <= MaxLineLen then       {build a line}
          begin
            CharNo:=CharNo+1;
            Paper[LineNo,CharNo+AddX]:=InChar;
          end;
    end;

          {at end of each line ...}

    If CharNo+AddX > LineLen then             {save longest line length}
      LineLen:=CharNo+AddX;
    LineSize[LineNo]:=CharNo+AddX;
    LineNo:=LineNo+1;
    CharNo:=0;
    If eoln(InFile) then
      ReadLn(InFile);                    {get the end-of-line mark}

      {force eject when page is full ...}

    If LineNo > MaxLinesPerPage then
      eject:=True;

until eof(InFile) OR (eject);

(*  make each line the same length *)

For i:=1 to MaxLinesPerPage do
  For j:=LineSize[i]+1 to LineLen do
    Paper[i,j]:=' ';

end;   {procedure ReadOnePage}

(*--------------------------------*)
(*        PRINT ONE PAGE          *)
(*--------------------------------*)

procedure PrintOnePage;

begin
  For j:=1 to LineLen do   {each rotated 'line'... actually, each character}
    begin
      For LineNo:=1 to PrintMultiple do
        begin
          If LineNo = 2 then Write(Lst,PrintMultipleSpacing);
          Write(Lst,GraphicsPrint,PrintType,N1,N2);
          For i:=MaxLinesPerPage downto 1 do    {lines in reverse order}
            begin
              Cindex:=Ord(Paper[i,j]);
              If BitsPerChar = 9 then {For loop (9 to ...) req'd if it is >9}
                Write(Lst,#0);
              For k:=7 downto 0 do
                Write(Lst,CharTable[Cindex][k]);   {bottom up each char}
            end;
        end;
        Write(Lst,JiggleDown);
        Write(Lst,LineFeed);
    end;
end;    {procedure PrintOnePage}


(* -------- MAIN PROGRAM -------- *)


begin

    (*  GET FILE PARAMETERS *)

  If Paramcount < 1 then
    begin
      WriteLn(^G'Missing file name on command line');
      Halt;
    end;
  Assign(RetFile,'C:RETURN.DAT');
  {$I-}
  Reset(RetFile);
  {$I+}
  If IOResult <> 0 then
    begin
      Writeln('File "RETURN.DAT" not found.');
      Halt;
    end;
  Assign(InFile,Paramstr(1));     {OPEN the file}
  {$I-}
  Reset(InFile);
  {$I+}
  If IOResult <> 0 then
    begin
      WriteLn('File "',Paramstr(1),'" not found.');
      Halt;
    end;

    (*  GET /D DOUBLE-PRINT OPTION  *)

  PrintMultiple:=1;
  If Paramcount >= 2 then
    If (Paramstr(2) = '/d') OR (paramstr(2) = '/D') then
      PrintMultiple:=2;

    (*  SET UP *)

  BitsPerPage:=BitsPerChar * MaxLinesPerPage;
  Write(Lst,ResetPrinter);

    (*  MAIN LOOP  *)

  Repeat       {do one "page" at a time}
    ReadOnePage;
    PrintOnePage;
    Write(Lst,FormFeed);      {do a page eject to line up properly}
  until eof(InFile);

    (*  ALL DONE  *)

  Close(InFile);
  Write(Lst,ResetPrinter);
  Write(Lst,NormalSpacing);        {resume normal spacing vertically}
end.   {main program}